home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / Preinstalled MacPerl (FAT) / lib / Term / Complete.pm < prev   
Encoding:
Text File  |  1995-03-20  |  2.9 KB  |  116 lines  |  [TEXT/McPL]
  1. die "Complete.pm not (yet) implemented on the Mac";
  2.  
  3. package Term::Complete;
  4. require 5.000;
  5. require Exporter;
  6.  
  7. @ISA = qw(Exporter);
  8. @EXPORT = qw(Complete);
  9.  
  10. #
  11. #      @(#)complete.pl,v1.1            (me@anywhere.EBay.Sun.COM) 09/23/91
  12. #
  13. # Author: Wayne Thompson
  14. #
  15. # Description:
  16. #     This routine provides word completion.
  17. #     (TAB) attempts word completion.
  18. #     (^D)  prints completion list.
  19. #      (These may be changed by setting $Complete::complete, etc.)
  20. #
  21. # Diagnostics:
  22. #     Bell when word completion fails.
  23. #
  24. # Dependencies:
  25. #     The tty driver is put into raw mode.
  26. #
  27. # Bugs:
  28. #
  29. # Usage:
  30. #     $input = complete('prompt_string', \@completion_list);
  31. #         or
  32. #     $input = complete('prompt_string', @completion_list);
  33. #
  34.  
  35. CONFIG: {
  36.     $complete = "\004";
  37.     $kill     = "\025";
  38.     $erase1 =   "\177";
  39.     $erase2 =   "\010";
  40. }
  41.  
  42. sub complete {
  43.     $prompt = shift;
  44.     if (ref $_[0] || $_[0] =~ /^\*/) {
  45.     @cmp_lst = sort @{$_[0]};
  46.     }
  47.     else {
  48.     @cmp_lst = sort(@_);
  49.     }
  50.  
  51.     system('stty raw -echo');
  52.     LOOP: {
  53.         print($prompt, $return);
  54.         while (($_ = getc(STDIN)) ne "\r") {
  55.             CASE: {
  56.                 # (TAB) attempt completion
  57.                 $_ eq "\t" && do {
  58.                     @match = grep(/^$return/, @cmp_lst);
  59.                     $l = length($test = shift(@match));
  60.                     unless ($#match < 0) {
  61.                         foreach $cmp (@match) {
  62.                             until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
  63.                                 $l--;
  64.                             }
  65.                         }
  66.                         print("\a");
  67.                     }
  68.                     print($test = substr($test, $r, $l - $r));
  69.                     $r = length($return .= $test);
  70.                     last CASE;
  71.                 };
  72.  
  73.                 # (^D) completion list
  74.                 $_ eq $complete && do {
  75.                     print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
  76.                     redo LOOP;
  77.                 };
  78.  
  79.                 # (^U) kill
  80.                 $_ eq $kill && do {
  81.                     if ($r) {
  82.                         undef($r, $return);
  83.                         print("\r\n");
  84.                         redo LOOP;
  85.                     }
  86.                     last CASE;
  87.                 };
  88.  
  89.                 # (DEL) || (BS) erase
  90.                 ($_ eq $erase1 || $_ eq $erase2) && do {
  91.                     if($r) {
  92.                         print("\b \b");
  93.                         chop($return);
  94.                         $r--;
  95.                     }
  96.                     last CASE;
  97.                 };
  98.  
  99.                 # printable char
  100.                 ord >= 32 && do {
  101.                     $return .= $_;
  102.                     $r++;
  103.                     print;
  104.                     last CASE;
  105.                 };
  106.             }
  107.         }
  108.     }
  109.     system('stty -raw echo');
  110.     print("\n");
  111.     $return;
  112. }
  113.  
  114. 1;
  115.  
  116.